perm filename SINE.PAS[S1,ALS] blob sn#394410 filedate 1979-07-23 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(*$A+,D+*)
C00004 ENDMK
CāŠ—;
(*$A+,D+*)

program	CHIOSINE(OUTPUT);

const NROW = 51;
      NCOL = 51;
      NCYCLES =	2;
      PI = 3.141593;
      TWOPI = 6.283185;
      PIOVER2 =	1.570796;
      IFACT3 = 0.1666667;
      IFACT5 = 0.008333333;
      IFACT7 = 0.0001984127;

var R, C :  integer;
    X, XARG, SIGNREV, XSQ, SINX	:  real;
    PAGE :  array [1..NROW,1..NCOL] of char;

begin
for R := 1 to NROW do
    for	C := 1 to NCOL do
	PAGE[R,C] := '.';
for C := 1 to NCOL do
    begin
    XARG := TWOPI * NCYCLES * (C-1) / (NCOL-1);
    X := XARG;
    SIGNREV := 1.0;
    if X < 0.0 then
	begin
	X := -X;
	SIGNREV	:= -SIGNREV
	end;
    X := X - TWOPI*trunc(X/TWOPI);
    case trunc(X/PIOVER2) of
     0:	;
     1:	X := PI	- X;
     2:	begin X	:= X - PI;  SIGNREV := -SIGNREV	end;
     3:	begin X	:= TWOPI - X;  SIGNREV := -SIGNREV end;
     4:	X := X - TWOPI
    end	(*case*);
    XSQ	:= X*X;
(*  SINX := SIGNREV*X*(1-XSQ*(1/6-XSQ*(1/120-XSQ*(1/5040))));  *)
    SINX := SIGNREV*X*(1-XSQ*(IFACT3-XSQ*(IFACT5-XSQ*(IFACT7))));
    R := (NROW+1) div 2	 +  trunc(((NROW-1) div	2) * SINX);
    PAGE[R,C] := '6'
    end;
for R := 1 to NROW do
    begin
    WRITE('.');
    for	C := 1 to NCOL do
	WRITE(PAGE[R,C]);
    WRITELN();
    end
end.